Phase II: Using Our Toolbox

class: center, middle, inverse, title-slide

.title[
# Phase II: Using Our Toolbox
]
.subtitle[
## Module 7: Birds of a Feather
]
.author[
### Dr. Christopher Kenaley
]
.institute[
### Boston College
]
.date[
### 2025/12/11
]

---

# In class today

<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.14.0/css/all.min.css">

.pull-left[
Today we'll ....

- Discuss `rgif` functions
- Explore the logistic curve

]

.pull-right[
![](https://www.billharlan.com/papers/logistic/fig1.png)
]

---
# When do birds arrive in Mass?

---

# When do birds arrive in Mass?

### eBird and GBIF

``` r
yr <- c(2021,2022,2023)

bhv_l <- list()

for(i in yr){
 bhv_l[[i]] <- occ_data(scientificName = "Vireo solitarius",
                year=i,
                month="3,6",
                limit=1000,
                country="US",
                basisOfRecord = "HUMAN_OBSERVATION",
                stateProvince="Massachusetts")[[2]] %>% 
   select(individualCount,
          year,month,day,
          decimalLongitude,
          decimalLatitude)
}

bhv <- do.call(rbind, bhv_l)
```

---

# When do birds arrive in Mass?

### eBird and GBIF

``` r
head(bhv %>% na.omit)
```

```
## # A tibble: 6 × 6
##   individualCount  year month   day decimalLongitude decimalLatitude
##             <int> <int> <int> <int>            <dbl>           <dbl>
## 1               1  2021     4    24            -71.8            42.6
## 2               1  2021     4    29            -72.5            42.4
## 3               1  2021     4    25            -70.9            42.7
## 4               1  2021     4    26            -72.6            42.5
## 5               1  2021     4    26            -71.1            42.4
## 6               1  2021     4    27            -72.7            42.4
```

---
# When do birds arrive in Mass?

.pull-left[

``` r
mass <- ne_states(country = 
                    "United States of America",
                  returnclass = "sf") %>% 
  filter(name=="Massachusetts")

p <- mass %>% 
  ggplot() +
  geom_sf()+
  geom_point(data=bhv,
             aes(decimalLongitude,
                 decimalLatitude,
                 col=as.factor(year)))
```
]

.pull-right[

``` r
print(p)
```

![](3140_f25_11-12_files/figure-html/unnamed-chunk-5-1.png)
]

---
# When do birds arrive in Mass?

.pull-left[

### The logistic curve
  
![](https://www.billharlan.com/papers/logistic/fig1.png)
]

---
# When do birds arrive in Mass?

### The logistic curve

``` r
bhv_arrive <- bhv%>%
  mutate(n=1:n()) %>%
  group_by(n) %>%
  mutate(date=as.Date(paste0(year,"-",month,"-",day)),
         j.day=julian(date,
                      origin=as.Date(paste0(unique(year),"-01-01")))
         )%>%
  na.omit() %>%
  group_by(year,j.day,date)%>%
  reframe(day.tot=sum(individualCount,na.rm=T))%>%
  group_by(year)%>%
  mutate(prop=cumsum(day.tot/sum(day.tot,na.rm = T)))
```

---
# When do birds arrive in Mass?

### The logistic curve

Let's break this down . . .

``` r
bhv_arrive <- bhv%>%
  mutate(n=1:n()) %>% #so functions can work on each row
  group_by(n) %>%
  mutate(date=as.Date(paste0(year,"-",month,"-",day)), #create a date object
         j.day=julian(date,
                      origin=as.Date(paste0(unique(year),"-01-01"))) 
         )%>% #julian day, why?
  na.omit() %>%
  group_by(year,j.day,date)%>%
  reframe(day.tot=sum(individualCount,na.rm=T))%>% #summarize with arbitrary number of rows for each group level
  group_by(year)%>%
  mutate(prop=cumsum(day.tot/sum(day.tot,na.rm = T))) #compute the proportion
```

---
# When do birds arrive in Mass?

.pull-left[
### The logistic curve

``` r
p <- bhv_arrive %>% 
  ggplot(aes(j.day,prop,col=as.factor(year))) +
  geom_point()
```
]

.pull-right[

``` r
print(p)
```

![](3140_f25_11-12_files/figure-html/unnamed-chunk-9-1.png)
]

---
# When do birds arrive in Mass?

### The logistic curve

``` r
bhv_pred <- bhv_arrive%>%
  group_by(year)%>%
 reframe(
   pred=predict(
     nls(prop~SSlogis(j.day,Asym, xmid, scal)),
     newdata=data.frame(j.day=min(j.day):max(j.day))),
   j.day=min(j.day):max(j.day),
  )%>%
  left_join(bhv_arrive%>%dplyr::select(j.day,date,prop)) #to get date and original proportion
```

---
# When do birds arrive in Mass?

.pull-left[

### The logistic curve

.pull-right[

non-linear least squares using `nls` package

`SSlogis`:

- vector `input` *

function then estimates initial values of:

- asymptote `Asym`
- inflection point `xmid` 
- scale `scal`

``` r
SSlogis(input,Asym, xmid, scal)
```

]
 
---
# When do birds arrive in Mass?

.pull-left[

### The logistic curve

``` r
p <- bhv_pred %>% 
  ggplot(aes(j.day,prop,col=as.factor(year)),alpha=0.3) +
  geom_point()+
  geom_line(aes(j.day,pred,))
```
]

.pull-left[
![](3140_f25_11-12_files/figure-html/unnamed-chunk-14-1.png)
]

---
# When do birds arrive in Mass?

.pull-left[

### The logistic curve
  
At what proportion have birds arrived?

``` r
p <- p+
  geom_hline(yintercept = 0.1)+
   geom_hline(yintercept = 0.25)+
  geom_hline(yintercept = 0.5)
```
]

.pull-left[
![](3140_f25_11-12_files/figure-html/unnamed-chunk-16-1.png)
]

---
# When do birds arrive in Mass?

.pull-left[

### The logistic curve
  
At what proportion have birds arrived?

``` r
bhv_arrive <- bhv_pred %>% 
  group_by(year)%>%
  filter(j.day==j.day[which.min(abs(pred-0.25))]) #
```
]

.pull-left[
![](3140_f25_11-12_files/figure-html/unnamed-chunk-18-1.png)
]